home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
rhtool2.zip
/
TV3D.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-20
|
13KB
|
120 lines
{*
*
* Copyright (c) 1992,93 by Richard W. Hansen
*
* This source code will compile.
* Full source code available to registered users.
*
*}
(* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
UNIT TV3D ;{$B+} {$X+} {$V-} {$I TVDEFS.INC} INTERFACE USES TVTYPE , APP , DIALOGS , DRIVERS , OBJECTS , VIEWS ;
CONST C3DDIALOG =#137#139#140#165#166#167#168#169#170#141+ #142#143#144#145#146#152#153#154#149#150+
#151#160#161#163#164#156#157#158#159#171+ #155#000#147#148#162;C3DBUTTON =#10#14#11#12#13#15;C3DHISTORY =#22#23#35;
C3DOUTLINE =#33#34;C3DTOOLBUTTON =#10#14#11#12#11#11;CONST BUTTONSELECT :TBXFRAMEARRAY ='╔╗╚╝║║══';
BUTTONNORMAL :TBXFRAMEARRAY ='┌┐└┘││──';BUTTONPRESS :TBXFRAMEARRAY ='┌┐└┘││──';OUTLINENORMAL :TBXFRAMEARRAY ='┌┐└┘││──';
TYPE PBX3DBUTTON =^TBX3DBUTTON ;TBX3DBUTTON =OBJECT (TBUTTON)DOWN :BOOLEAN ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;
ATITLE :TTITLESTR ;ACOMMAND :WORD ;AFLAGS :WORD );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE DRAW ;VIRTUAL;
PROCEDURE DRAWTITLE (ATITLE :TTITLESTR ;COLOR :WORD ;ROW :WORD );VIRTUAL;PROCEDURE GETFRAME (VAR F :TBXFRAMEARRAY );
VIRTUAL;FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;END ;
PBX3DOUTLINE =^TBX3DOUTLINE ;TBX3DOUTLINE =OBJECT (TVIEW)CONSTRUCTOR INIT (VAR BOUNDS :TRECT );PROCEDURE DRAW ;VIRTUAL;
PROCEDURE GETFRAME (VAR F :TBXFRAMEARRAY );VIRTUAL;FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;END ;
PBX3DHISTORY =^TBX3DHISTORY ;TBX3DHISTORY =OBJECT (THISTORY)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ALINK :PINPUTLINE ;
AHISTORYID :WORD );PROCEDURE DRAW ;VIRTUAL;FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;END ;PBX3DDIALOG =^TBX3DDIALOG ;
TBX3DDIALOG =OBJECT (TDIALOG)FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;PROCEDURE INSERT (P :PVIEW );VIRTUAL;END ;
PBX3DTOOLBUTTON =^TBX3DTOOLBUTTON ;TBX3DTOOLBUTTON =OBJECT (TBX3DBUTTON)PROCEDURE GETFRAME (VAR F :TBXFRAMEARRAY );
VIRTUAL;FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;END ;PBX3DTOOLBAR =^TBX3DTOOLBAR ;
TBX3DTOOLBAR =OBJECT (TBX3DDIALOG)ISVERTICAL :BOOLEAN ;LASTX :WORD ;LASTY :WORD ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;
VERTICAL :BOOLEAN );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE ADDTOOL (ATITLE :TTITLESTR ;ACOMMAND :WORD );
PROCEDURE INITFRAME ;VIRTUAL;PROCEDURE SIZELIMITS (VAR MIN ,MAX:TPOINT );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );END ;
PROCEDURE REGISTERTV3D ;CONST RBX3DBUTTON :TSTREAMREC =(OBJTYPE :5000 ;VMTLINK :OFS (TYPEOF (TBX3DBUTTON )^);LOAD :@
TBX3DBUTTON . LOAD ;STORE :@ TBX3DBUTTON . STORE );CONST RBX3DOUTLINE :TSTREAMREC =(OBJTYPE :5001 ;
VMTLINK :OFS (TYPEOF (TBX3DOUTLINE )^);LOAD :@ TBX3DOUTLINE . LOAD ;STORE :@ TBX3DOUTLINE . STORE );
CONST RBX3DHISTORY :TSTREAMREC =(OBJTYPE :5002 ;VMTLINK :OFS (TYPEOF (TBX3DHISTORY )^);LOAD :@ TBX3DHISTORY . LOAD ;
STORE :@ TBX3DHISTORY . STORE );CONST RBX3DDIALOG :TSTREAMREC =(OBJTYPE :5003 ;VMTLINK :OFS (TYPEOF (TBX3DDIALOG )^);
LOAD :@ TBX3DDIALOG . LOAD ;STORE :@ TBX3DDIALOG . STORE );CONST RBX3DTOOLBUTTON :TSTREAMREC =(OBJTYPE :5004 ;
VMTLINK :OFS (TYPEOF (TBX3DTOOLBUTTON )^);LOAD :@ TBX3DTOOLBUTTON . LOAD ;STORE :@ TBX3DTOOLBUTTON . STORE );
CONST RBX3DTOOLBAR :TSTREAMREC =(OBJTYPE :5005 ;VMTLINK :OFS (TYPEOF (TBX3DTOOLBAR )^);LOAD :@ TBX3DTOOLBAR . LOAD ;
STORE :@ TBX3DTOOLBAR . STORE );IMPLEMENTATION CONSTRUCTOR TBX3DBUTTON.INIT (VAR BOUNDS:TRECT;ATITLE:TTITLESTR;
ACOMMAND:WORD;AFLAGS:WORD);BEGIN INHERITED INIT(BOUNDS , ATITLE , ACOMMAND , AFLAGS );DOWN := FALSE ;END ;
CONSTRUCTOR TBX3DBUTTON.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );DOWN := FALSE ;END ;PROCEDURE TBX3DBUTTON.DRAW ;
VAR O10OO0O0OOOO1:TBXFRAMEARRAY;OOIl:WORD;OOIO:WORD;OOIO01I11II0:WORD;OO01IOOl0II:WORD;OIO1:TDRAWBUFFER;BEGIN GETFRAME
(O10OO0O0OOOO1 );IF (STATE AND SFDISABLED <> 0 )THEN OO01IOOl0II := GETCOLOR ($0404 )ELSE IF (STATE AND SFSELECTED =0
)AND AMDEFAULT THEN OO01IOOl0II := GETCOLOR ($0506 )ELSE IF (STATE AND SFSELECTED <> 0 )THEN OO01IOOl0II := GETCOLOR
($0606 )ELSE OO01IOOl0II := GETCOLOR ($0503 );IF DOWN THEN OOIO01I11II0 := GETCOLOR ($0201 )ELSE OOIO01I11II0 := GETCOLOR
($0102 );OOIO := SIZE.X - 1 ;MOVECHAR (OIO1 , O10OO0O0OOOO1 [ 7 ] , WORDREC (OOIO01I11II0 ). HI , SIZE.X );WORDREC (OIO1
[ OOIO ] ). HI := WORDREC (OOIO01I11II0 ). LO ;WORDREC (OIO1 [ 0 ] ). LO := BYTE (O10OO0O0OOOO1 [ 1 ] );WORDREC (OIO1 [
OOIO ] ). LO := BYTE (O10OO0O0OOOO1 [ 2 ] );WRITELINE (0 , 0 , SIZE.X , 1 , OIO1 );MOVECHAR (OIO1 , O10OO0O0OOOO1 [ 8 ] ,
WORDREC (OOIO01I11II0 ). LO , SIZE.X );WORDREC (OIO1 [ 0 ] ). HI := WORDREC (OOIO01I11II0 ). HI ;WORDREC (OIO1 [ 0 ] ).
LO := BYTE (O10OO0O0OOOO1 [ 3 ] );WORDREC (OIO1 [ OOIO ] ). LO := BYTE (O10OO0O0OOOO1 [ 4 ] );WRITELINE (0 , SIZE.Y - 1 ,
SIZE.X , 1 , OIO1 );MOVECHAR (OIO1 , ' ', WORDREC (OOIO01I11II0 ). HI , SIZE.X );WORDREC (OIO1 [ 0 ] ). LO := BYTE
(O10OO0O0OOOO1 [ 5 ] );WORDREC (OIO1 [ OOIO ] ). LO := BYTE (O10OO0O0OOOO1 [ 6 ] );WORDREC (OIO1 [ OOIO ] ). HI :=
WORDREC (OOIO01I11II0 ). LO ;FOR OOIl := 1 TO SIZE.Y - 2 DO WRITELINE (0 , OOIl , SIZE.X , 1 , OIO1 );OOIO := POS (^M ,
TITLE ^);IF (OOIO =0 )THEN OOIl := SIZE.Y DIV 2 ELSE OOIl := (SIZE.Y - 1 )DIV 2 ;IF (OOIO =0 )THEN DRAWTITLE (TITLE ^,
OO01IOOl0II , OOIl )ELSE BEGIN DRAWTITLE (COPY (TITLE ^, 1 , OOIO - 1 ), OO01IOOl0II , OOIl );DRAWTITLE (COPY (TITLE ^,
OOIO + 1 , LENGTH (TITLE ^)), OO01IOOl0II , OOIl + 1 );END ;END ;PROCEDURE TBX3DBUTTON.DRAWTITLE (ATITLE:TTITLESTR;
COLOR:WORD;ROW:WORD);VAR OOIO:WORD;OO01:WORD;OIO1:TDRAWBUFFER;BEGIN OO01 := SIZE.X - 2 ;IF (FLAGS AND BFLEFTJUST <> 0
)THEN OOIO := 0 ELSE OOIO := (OO01 - CSTRLEN (ATITLE ))DIV 2 ;MOVECHAR (OIO1 , ' ', WORDREC (COLOR ). LO , OO01 );
MOVECSTR (OIO1 [ OOIO ] , ATITLE , COLOR );WRITELINE (1 , ROW , OO01 , 1 , OIO1 );END ;PROCEDURE TBX3DBUTTON.GETFRAME
(VAR F:TBXFRAMEARRAY);BEGIN IF DOWN THEN F := BUTTONPRESS ELSE IF (STATE AND SFSELECTED <> 0 )THEN F := BUTTONSELECT ELSE
F := BUTTONNORMAL ;END ;FUNCTION TBX3DBUTTON.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(C3DBUTTON)] =C3DBUTTON;
BEGIN GETPALETTE := @ OO10 ;END ;PROCEDURE TBX3DBUTTON.HANDLEEVENT (VAR EVENT:TEVENT);VAR OO1I:TRECT;OO10:TPOINT;
BEGIN GETEXTENT (OO1I );IF (EVENT.WHAT =EVMOUSEDOWN )THEN BEGIN MAKELOCAL (EVENT.WHERE , OO10 );IF NOT OO1I.CONTAINS
(OO10 )THEN CLEAREVENT (EVENT );IF (FLAGS AND BFGRABFOCUS <> 0 )THEN TVIEW.HANDLEEVENT (EVENT );IF (EVENT.WHAT
=EVMOUSEDOWN )THEN BEGIN DOWN := FALSE ;REPEAT MAKELOCAL (EVENT.WHERE , OO10 );IF (DOWN <> OO1I.CONTAINS (OO10 ))THEN
BEGIN DOWN := NOT DOWN ;DRAW ;END ;UNTIL NOT MOUSEEVENT (EVENT , EVMOUSEMOVE );IF DOWN THEN BEGIN DOWN := FALSE ;PRESS ;
DRAW ;END ;CLEAREVENT (EVENT );END ;END ;INHERITED HANDLEEVENT(EVENT );END ;CONSTRUCTOR TBX3DOUTLINE.INIT
(VAR BOUNDS:TRECT);VAR OO1I:TRECT;BEGIN OO1I := BOUNDS ;OO1I.GROW (1 , 1 );INHERITED INIT(OO1I );END ;
FUNCTION TBX3DOUTLINE.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(C3DOUTLINE)] =C3DOUTLINE;BEGIN GETPALETTE := @
OO10 ;END ;PROCEDURE TBX3DOUTLINE.GETFRAME (VAR F:TBXFRAMEARRAY);BEGIN F := OUTLINENORMAL ;END ;
PROCEDURE TBX3DOUTLINE.DRAW ;VAR O10OO0O0OOOO1:TBXFRAMEARRAY;OOIO01I11II0:WORD;OOIO:WORD;OOIl:WORD;OIO1:TDRAWBUFFER;
BEGIN GETFRAME (O10OO0O0OOOO1 );OOIO01I11II0 := GETCOLOR ($0102 );OOIO := SIZE.X - 1 ;MOVECHAR (OIO1 , O10OO0O0OOOO1 [ 7
] , WORDREC (OOIO01I11II0 ). LO , SIZE.X );WORDREC (OIO1 [ OOIO ] ). HI := WORDREC (OOIO01I11II0 ). HI ;WORDREC (OIO1 [ 0
] ). LO := BYTE (O10OO0O0OOOO1 [ 1 ] );WORDREC (OIO1 [ OOIO ] ). LO := BYTE (O10OO0O0OOOO1 [ 2 ] );WRITELINE (0 , 0 ,
SIZE.X , 1 , OIO1 );MOVECHAR (OIO1 , O10OO0O0OOOO1 [ 8 ] , WORDREC (OOIO01I11II0 ). HI , SIZE.X );WORDREC (OIO1 [ 0 ] ).
HI := WORDREC (OOIO01I11II0 ). LO ;WORDREC (OIO1 [ 0 ] ). LO := BYTE (O10OO0O0OOOO1 [ 3 ] );WORDREC (OIO1 [ OOIO ] ). LO
:= BYTE (O10OO0O0OOOO1 [ 4 ] );WRITELINE (0 , SIZE.Y - 1 , SIZE.X , 1 , OIO1 );FOR OOIl := 1 TO SIZE.Y - 2
DO BEGIN WRITECHAR (0 , OOIl , O10OO0O0OOOO1 [ 5 ] , 2 , 1 );WRITECHAR (OOIO , OOIl , O10OO0O0OOOO1 [ 6 ] , 1 , 1 );
END ;END ;CONSTRUCTOR TBX3DHISTORY.INIT (VAR BOUNDS:TRECT;ALINK:PINPUTLINE;AHISTORYID:WORD);BEGIN BOUNDS.GROW (0 , 1 );
INHERITED INIT(BOUNDS , ALINK , AHISTORYID );END ;PROCEDURE TBX3DHISTORY.DRAW ;VAR OOIO01I11II0:WORD;OOIO:WORD;
OIO1:TDRAWBUFFER;BEGIN OOIO := SIZE.X - 1 ;OOIO01I11II0 := GETCOLOR ($0203 );MOVECHAR (OIO1 , BUTTONNORMAL [ 7 ] ,
WORDREC (OOIO01I11II0 ). HI , SIZE.X );WORDREC (OIO1 [ OOIO ] ). HI := WORDREC (OOIO01I11II0 ). LO ;WORDREC (OIO1 [ 0 ]
). LO := BYTE (BUTTONNORMAL [ 1 ] );WORDREC (OIO1 [ OOIO ] ). LO := BYTE (BUTTONNORMAL [ 2 ] );WRITELINE (0 , 0 , SIZE.X
, 1 , OIO1 );MOVECHAR (OIO1 , BUTTONNORMAL [ 8 ] , WORDREC (OOIO01I11II0 ). LO , SIZE.X );WORDREC (OIO1 [ 0 ] ). HI :=
WORDREC (OOIO01I11II0 ). HI ;WORDREC (OIO1 [ 0 ] ). LO := BYTE (BUTTONNORMAL [ 3 ] );WORDREC (OIO1 [ OOIO ] ). LO := BYTE
(BUTTONNORMAL [ 4 ] );WRITELINE (0 , SIZE.Y - 1 , SIZE.X , 1 , OIO1 );MOVECHAR (OIO1 , ' ', WORDREC (OOIO01I11II0 ). HI ,
SIZE.X );WORDREC (OIO1 [ 0 ] ). LO := BYTE (BUTTONNORMAL [ 5 ] );WORDREC (OIO1 [ OOIO ] ). LO := BYTE (BUTTONNORMAL [ 6 ]
);WORDREC (OIO1 [ OOIO ] ). HI := WORDREC (OOIO01I11II0 ). LO ;WORDREC (OIO1 [ 1 ] ). LO := 25 ;OOIO01I11II0 := GETCOLOR
($01 );WORDREC (OIO1 [ 1 ] ). HI := WORDREC (OOIO01I11II0 ). LO ;WRITELINE (0 , 1 , SIZE.X , 1 , OIO1 );END ;
FUNCTION TBX3DHISTORY.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(C3DHISTORY)] =C3DHISTORY;BEGIN GETPALETTE := @
OO10 ;END ;FUNCTION TBX3DDIALOG.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(C3DDIALOG)] =C3DDIALOG;BEGIN GETPALETTE
:= @ OO10 ;END ;PROCEDURE TBX3DDIALOG.INSERT (P:PVIEW);VAR OO1I:TRECT;OIl0:PVIEW;BEGIN IF (P ^. OPTIONS AND OFFRAMED <> 0
)THEN BEGIN P ^. GETBOUNDS (OO1I );OIl0 := NEW (PBX3DOUTLINE , INIT (OO1I ));INHERITED INSERT(OIl0 );END ;
INHERITED INSERT(P );END ;PROCEDURE TBX3DTOOLBUTTON.GETFRAME (VAR F:TBXFRAMEARRAY);BEGIN IF DOWN THEN F := BUTTONPRESS
ELSE F := BUTTONNORMAL ;END ;FUNCTION TBX3DTOOLBUTTON.GETPALETTE :PPALETTE ;CONST OO10:STRING [ LENGTH(C3DTOOLBUTTON)]
=C3DTOOLBUTTON;BEGIN GETPALETTE := @ OO10 ;END ;CONSTRUCTOR TBX3DTOOLBAR.INIT (VAR BOUNDS:TRECT;VERTICAL:BOOLEAN);
VAR OO1I:TRECT;OO10:PVIEW;BEGIN INHERITED INIT(BOUNDS , '');ISVERTICAL := VERTICAL ;SETSTATE (SFSHADOW , FALSE );OPTIONS
:= OPTIONS AND NOT OFTILEABLE AND NOT OFSELECTABLE OR OFFIRSTCLICK ;FLAGS := FLAGS AND NOT WFCLOSE ;GETEXTENT (OO1I );IF
(FRAME <> NIL )THEN BEGIN LASTX := 1 ;LASTY := 1 ;OO1I.GROW (- 1 , - 1 );END ELSE BEGIN LASTX := 0 ;LASTY := 0 ;END ;
OO10 := NEW (PVIEW , INIT (OO1I ));OO10 ^. SETSTATE (SFDISABLED , TRUE );OO10 ^. OPTIONS := OO10 ^. OPTIONS AND NOT
OFSELECTABLE ;OO10 ^. GROWMODE := OO10 ^. GROWMODE OR GFGROWHIX OR GFGROWHIY ;INSERT (OO10 );END ;
CONSTRUCTOR TBX3DTOOLBAR.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (ISVERTICAL , SIZEOF (BOOLEAN ));S.READ
(LASTX , SIZEOF (WORD ));S.READ (LASTY , SIZEOF (WORD ));END ;PROCEDURE TBX3DTOOLBAR.ADDTOOL (ATITLE:TTITLESTR;
ACOMMAND:WORD);VAR OO1I:TRECT;OIO1:TRECT;OIO0O1I11lO:WORD;O10OI0O10I0O0:WORD;O10OOll1OlI01:WORD;O10OIO0l0I0Il:WORD;
O1I10Ol1:WORD;O1I1Il0I:WORD;OIlIl0l11OO:WORD;OIIIlIOO0II:WORD;BEGIN O10OIO0l0I0Il := POS (^M , ATITLE );IF (O10OIO0l0I0Il
=0 )THEN BEGIN O10OOll1OlI01 := 3 ;O10OI0O10I0O0 := CSTRLEN (ATITLE );END ELSE BEGIN O10OOll1OlI01 := 4 ;O10OI0O10I0O0 :=
CSTRLEN (COPY (ATITLE , 1 , O10OIO0l0I0Il - 1 ));OIO0O1I11lO := CSTRLEN (COPY (ATITLE , O10OIO0l0I0Il + 1 , LENGTH
(ATITLE )));IF (OIO0O1I11lO > O10OI0O10I0O0 )THEN O10OI0O10I0O0 := OIO0O1I11lO ;END ;O10OI0O10I0O0 := O10OI0O10I0O0 + 2 ;
OO1I.A.X := LASTX ;OO1I.A.Y := LASTY ;OO1I.B.X := OO1I.A.X + O10OI0O10I0O0 ;OO1I.B.Y := OO1I.A.Y + O10OOll1OlI01 ;
OIlIl0l11OO := SIZE.X ;OIIIlIOO0II := SIZE.Y ;IF (FRAME <> NIL )THEN BEGIN DEC (OIlIl0l11OO );DEC (OIIIlIOO0II );END ;IF
(OO1I.B.Y > OIIIlIOO0II )THEN O1I1Il0I := OO1I.B.Y - OIIIlIOO0II ELSE O1I1Il0I := 0 ;IF (OO1I.B.X > OIlIl0l11OO )THEN
O1I10Ol1 := OO1I.B.X - OIlIl0l11OO ELSE O1I10Ol1 := 0 ;GETBOUNDS (OIO1 );IF (O1I1Il0I <> 0 )THEN BEGIN OIO1.B.Y :=
OIO1.B.Y + O1I1Il0I ;IF (OIO1.B.Y > DESKTOP ^. SIZE.Y )THEN EXIT ;END ;IF (O1I10Ol1 <> 0 )THEN BEGIN OIO1.B.X := OIO1.B.X
+ O1I10Ol1 ;IF (OIO1.B.X > DESKTOP ^. SIZE.X )THEN EXIT ;END ;IF (O1I10Ol1 <> 0 )OR (O1I1Il0I <> 0 )THEN IF (STATE AND
SFVISIBLE <> 0 )THEN CHANGEBOUNDS (OIO1 )ELSE SETBOUNDS (OIO1 );INSERT (NEW (PBX3DTOOLBUTTON , INIT (OO1I , ATITLE ,
ACOMMAND , 0 )));IF ISVERTICAL THEN LASTY := OO1I.B.Y ELSE LASTX := OO1I.B.X ;END ;PROCEDURE TBX3DTOOLBAR.INITFRAME ;
BEGIN FRAME := NIL ;END ;PROCEDURE TBX3DTOOLBAR.SIZELIMITS (VAR MIN,MAX:TPOINT);BEGIN MIN := SIZE ;MAX := SIZE ;END ;
PROCEDURE TBX3DTOOLBAR.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (ISVERTICAL , SIZEOF (BOOLEAN ));S.WRITE
(LASTX , SIZEOF (WORD ));S.WRITE (LASTY , SIZEOF (WORD ));END ;PROCEDURE REGISTERTV3D ;BEGIN REGISTERTYPE (RBX3DBUTTON );
REGISTERTYPE (RBX3DOUTLINE );REGISTERTYPE (RBX3DHISTORY );REGISTERTYPE (RBX3DDIALOG );REGISTERTYPE (RBX3DTOOLBUTTON );
REGISTERTYPE (RBX3DTOOLBAR );END ;END .